unit ROADataSetHelper;

interface

uses
    SysUtils, DB, SqlExpr, Variants;

type
    TSQLSTMT = type string;
    TParamDirection = (pdInput, pdOutput, pdInputOutput);
    TROASQLCommandType = (sctFetch, sctModify);
    {TSQLParams = array of TVarRec;}

    EROAParams = class(Exception);
    EROADataSetHelper = class(Exception);

    PROAParamInfo = ^TROAParamInfo;
    PArrayROAParamInfo = ^TArrayROAParamInfo;

    TCustomROADataSetHelper = class(TObject)
    private
        {class var }FSQLConnection: SqlExpr.TSQLConnection;
        class procedure AddROAParam(AROAArrayParamInfo: PArrayROAParamInfo; AParamLocation: System.Integer; AParamValue: System.TVarRec; ANamedParam: System.Boolean = False);
        class function CheckParam(const AParam: TVarRec; var AFieldType: DB.TFieldType): System.Variant;
        class function CompareParams(const Stmt: TSQLSTMT; const Params: array of const): Boolean;
        class function CreateParams(const Stmt: TSQLSTMT; const Params: array of const): DB.TParams;
        class procedure SubstNonNamedParams(var Stmt: TSQLSTMT);
    public
        class function ExecSQL(const AConnection: TSQLConnection; const Stmt: TSQLSTMT; const Params: array of const; ACommandType: TROASQLCommandType = sctFetch; ExecIndirect: System.Boolean = System.False): SQLExpr.TSqlQuery;
        property SQLConnection: SqlExpr.TSQLConnection read FSQLConnection write FSQLConnection;
    end;

    TROAParamLocation = record
        x: System.Integer;
    end;

    TROAParamInfo = record
        IdParam: System.Integer;
        ParamLocation: TROAParamLocation;
        ParamValue: System.Variant;
        Named: System.Boolean;
        Used: System.Boolean;
        FieldType: DB.TFieldType;
    end;

    TArrayROAParamInfo = array of TROAParamInfo;

implementation

const
    SQuestionMark = #63;
    SParamMarkNonNamed = SQuestionMark;
    SParamMarkNamed = #58;

var
    ParamsInfo: TArrayROAParamInfo;

class procedure TCustomROADataSetHelper.AddROAParam(AROAArrayParamInfo: PArrayROAParamInfo; AParamLocation: System.Integer; AParamValue: System.TVarRec; ANamedParam: System.Boolean = False);
begin
    SetLength(AROAArrayParamInfo^, System.Length(AROAArrayParamInfo^) + 1);
    with AROAArrayParamInfo^[System.High(AROAArrayParamInfo^)] do
    begin
        if (System.High(AROAArrayParamInfo^) = 0) then IdParam := 1
        else IdParam := AROAArrayParamInfo^[System.High(AROAArrayParamInfo^) - 1].IdParam + 1;
        ParamLocation.x := AParamLocation;
        ParamValue := CheckParam(AParamValue, FieldType);
        Named := ANamedParam;
        Used := System.False;
    end;
end;

class function TCustomROADataSetHelper.CheckParam(const AParam: TVarRec; var AFieldType: DB.TFieldType): System.Variant;
begin
    case AParam.VType of
        vtInteger:
        begin
            Result := AParam.VInteger;
            AFieldType := ftInteger;
        end;
        vtBoolean:
        begin
            Result := AParam.VBoolean;
            AFieldType := ftBoolean;
        end;
        vtChar:
        begin
            Result := AParam.VChar;
            AFieldType := ftString;
        end;
        vtExtended:
        begin
            Result := AParam.VExtended^;
            AFieldType := ftFloat;
        end;
        vtString:
        begin
            Result := QuotedStr(AParam.VString^);
            AFieldType := ftString;
        end;
        vtAnsiString:
        begin
            Result := QuotedStr(System.AnsiString(AParam.VAnsiString));
            AFieldType := ftString;
        end;
        vtPChar:
        begin
            Result := AParam.VPChar^;
            AFieldType := ftString;
        end;
        vtCurrency:
        begin
            Result := AParam.VCurrency^;
            AFieldType := ftCurrency;
         end;
        vtVariant:
        begin
            Result := AParam.VVariant^;
            AFieldType := ftVariant;
        end;
        vtInt64:
        begin
            Result := AParam.VInt64^;
            AFieldType := ftInteger;
        end;
    end;
end;

class function TCustomROADataSetHelper.CompareParams(const Stmt: TSQLSTMT; const Params: array of const): Boolean;
var
    PStmt: System.PChar;
    TotalParams: System.Byte;
    ParamLocation: System.Integer;
begin
    PStmt := System.PChar(Stmt);
    TotalParams := 0;
    ParamLocation := 0;
    ParamsInfo := nil;
    SetLength(ParamsInfo, 0);
    while (PStmt^ <> #0) do
    begin
        case PStmt^ of
            SParamMarkNamed:
            begin
                if ((PStmt + 1)^ in [#65..#90, #97..#122]) then
                begin
                    AddROAParam(@ParamsInfo, ParamLocation, Params[TotalParams], System.True);
                    Inc(TotalParams, 1);
                end
                else
                    raise EROAParams.Create('Incorrect parameter definition.');
            end;
            SQuestionMark:
            begin
                AddROAParam(@ParamsInfo, ParamLocation, Params[TotalParams]);
                System.Inc(TotalParams, 1);
            end;
        end;
        Inc(PStmt, 1);
        Inc(ParamLocation, 1);
    end;
    Result := TotalParams = Length(Params);
end;

class function TCustomROADataSetHelper.ExecSQL(const AConnection: TSQLConnection; const Stmt: TSQLSTMT; const Params: array of const; ACommandType: TROASQLCommandType = sctFetch; ExecIndirect: System.Boolean = System.False): SqlExpr.TSQLQuery;
var
    ADataSet: SqlExpr.TSQLQuery;
    tmpStmt: TSQLSTMT;
begin
    if not CompareParams(Stmt, Params) then
        raise EROAParams.Create('Parameters count mismatch.');

    // Creates and initializes query object
    tmpStmt := Stmt;
    SubstNonNamedParams(tmpStmt);
    ADataSet := SqlExpr.TSQLQuery.Create(nil);
    ADataSet.SQL.Text := tmpStmt;

    // Creates parameters, one by one to avoid erros at parameter's creation
    ADataSet.Params.Clear;
    ADataSet.Params.Assign(CreateParams(Stmt, Params));
    if (not System.Assigned(AConnection)) then
        raise EROADataSetHelper.Create('There is no one connection assigned')
    else
        ADataSet.SQLConnection := AConnection;

    // Open or executes SQL Statement
    case ACommandType of
        sctFetch: ADataSet.Active := System.True;
        else ADataSet.ExecSQL(ExecIndirect);
    end;
    Result := ADataSet;
end;

class function TCustomROADataSetHelper.CreateParams(const Stmt: TSQLSTMT; const Params: array of const): DB.TParams;

    function CreateNewParam(AParamsCollection: DB.TParams; AFieldType: TFieldType; ASize: System.Integer; AValue: Variant; ParamDirection: TParamDirection = pdInput): DB.TParam;
    begin
        Result := DB.TParam.Create(AParamsCollection);
        Result.DataType := AFieldType;
        Result.Size := ASize;
        case ParamDirection of
            pdInput: Result.ParamType := ptInput;
            pdOutput: Result.ParamType := ptOutput;
            else Result.ParamType := ptInputOutput;
        end;
        Result.Value := AValue;
        AParamsCollection.AddParam(Result);
    end;

var
    I: System.Integer;
    FieldType: DB.TFieldType;
begin
    Result := DB.TParams.Create(nil);
    FieldType := ftUnknown;
    for I := System.Low(ParamsInfo) to System.High(ParamsInfo) do
    begin
        if ((ParamsInfo[I].Named) and (not ParamsInfo[I].Used)) then
        begin
            CreateNewParam(Result, FieldType, 0, ParamsInfo[I].ParamValue);
            ParamsInfo[I].Used := System.True;
        end;
    end;
end;

class procedure TCustomROADataSetHelper.SubstNonNamedParams(var Stmt: TSQLSTMT);
var
    I, J, LastIndex: System.Integer;
    tmpStr: System.string;
begin
    tmpStr := SysUtils.EmptyStr;
    LastIndex := System.Low(ParamsInfo);
    for I := 1 to System.Length(Stmt) do
    begin
        if (Stmt[I] = SQuestionMark) then
        begin
            for J := LastIndex to System.High(ParamsInfo) do
            begin
                if (not (ParamsInfo[J].Named) and (not ParamsInfo[J].Used)) then
                begin
                    tmpStr := tmpStr + Variants.VarToStr(ParamsInfo[LastIndex].ParamValue);
                    ParamsInfo[LastIndex].Used := System.True;
                end;
                System.Inc(LastIndex);
            end;
        end
        else
            tmpStr := tmpStr + Stmt[I];
    end;
    Stmt := tmpStr;
end;

end.